Capitolul 1
## Loading required package: tergm
## Loading required package: ergm
## Loading required package: network
## network: Classes for Relational Data
## Version 1.16.1 created on 2020-10-06.
## copyright (c) 2005, Carter T. Butts, University of California-Irvine
## Mark S. Handcock, University of California -- Los Angeles
## David R. Hunter, Penn State University
## Martina Morris, University of Washington
## Skye Bender-deMoll, University of Washington
## For citation information, type citation("network").
## Type help("network-package") to get started.
##
## ergm: version 3.11.0, created on 2020-10-14
## Copyright (c) 2020, Mark S. Handcock, University of California -- Los Angeles
## David R. Hunter, Penn State University
## Carter T. Butts, University of California -- Irvine
## Steven M. Goodreau, University of Washington
## Pavel N. Krivitsky, UNSW Sydney
## Martina Morris, University of Washington
## with contributions from
## Li Wang
## Kirk Li, University of Washington
## Skye Bender-deMoll, University of Washington
## Chad Klumb
## Michał Bojanowski, Kozminski University
## Ben Bolker
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("ergm").
## NOTE: Versions before 3.6.1 had a bug in the implementation of the bd()
## constraint which distorted the sampled distribution somewhat. In
## addition, Sampson's Monks datasets had mislabeled vertices. See the
## NEWS and the documentation for more details.
## NOTE: Some common term arguments pertaining to vertex attribute and
## level selection have changed in 3.10.0. See terms help for more
## details. Use 'options(ergm.term=list(version="3.9.4"))' to use old
## behavior.
## Loading required package: networkDynamic
##
## networkDynamic: version 0.10.1, created on 2020-01-16
## Copyright (c) 2020, Carter T. Butts, University of California -- Irvine
## Ayn Leslie-Cook, University of Washington
## Pavel N. Krivitsky, University of Wollongong
## Skye Bender-deMoll, University of Washington
## with contributions from
## Zack Almquist, University of California -- Irvine
## David R. Hunter, Penn State University
## Li Wang
## Kirk Li, University of Washington
## Steven M. Goodreau, University of Washington
## Jeffrey Horner
## Martina Morris, University of Washington
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("networkDynamic").
##
## tergm: version 3.7.0, created on 2020-10-15
## Copyright (c) 2020, Pavel N. Krivitsky, UNSW Sydney
## Mark S. Handcock, University of California -- Los Angeles
## with contributions from
## David R. Hunter, Penn State University
## Steven M. Goodreau, University of Washington
## Martina Morris, University of Washington
## Nicole Bohme Carnegie, New York University
## Carter T. Butts, University of California -- Irvine
## Ayn Leslie-Cook, University of Washington
## Skye Bender-deMoll
## Li Wang
## Kirk Li, University of Washington
## Chad Klumb
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("tergm").
## Loading required package: ergm.count
##
## ergm.count: version 3.4.0, created on 2019-05-15
## Copyright (c) 2019, Pavel N. Krivitsky, University of Wollongong
## with contributions from
## Mark S. Handcock, University of California -- Los Angeles
## David R. Hunter, Penn State University
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("ergm.count").
## NOTE: The form of the term 'CMP' has been changed in version 3.2 of
## 'ergm.count'. See the news or help('CMP') for more information.
## Loading required package: sna
## Loading required package: statnet.common
##
## Attaching package: 'statnet.common'
## The following object is masked from 'package:base':
##
## order
## sna: Tools for Social Network Analysis
## Version 2.6 created on 2020-10-5.
## copyright (c) 2005, Carter T. Butts, University of California-Irvine
## For citation information, type citation("sna").
## Type help(package="sna") to get started.
## Loading required package: tsna
##
## statnet: version 2019.6, created on 2019-06-13
## Copyright (c) 2019, Mark S. Handcock, University of California -- Los Angeles
## David R. Hunter, Penn State University
## Carter T. Butts, University of California -- Irvine
## Steven M. Goodreau, University of Washington
## Pavel N. Krivitsky, University of Wollongong
## Skye Bender-deMoll
## Martina Morris, University of Washington
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("statnet").
library(RColorBrewer)
library(network)
netmat <- rbind(c(1,2),
c(1,3),
c(2,3),
c(1,4),
c(5,6),
c(7,8),
c(5,7),
c(5,8),
c(5,9),
c(6,7),
c(6,8),
c(6,9),
c(5,10),
c(6,10),
c(11,12),
c(11,13),
c(13,14),
c(14,19),
c(13,19),
c(14,1),
c(19,15),
c(19,16),
c(19,17),
c(19,18),
c(12,15),
c(12,16),
c(12,17),
c(12,18),
c(20,8),
c(20,9),
c(21,8),
c(21,9),
c(3,8),
c(3,9),
c(1,8),
c(1,9))
net <- network(netmat, matrix.type="edgelist")
netmatsym <- symmetrize(as.sociomatrix(net), rule ="weak")
netsym <- network(netmatsym, matrix.type="adjacency")
network.vertex.names(netsym) <- c("B***cu L***na",
"B***cu An***us",
"B**scu C***nel",
"B**hiu G***ge",
"M**tu M**na",
"Ma**u I***he",
"T**a F**p",
"T**a G***ghe",
"S**m An**la",
"G**ca G****ghe",
"C**u I**n",
"M***u L**do",
"D**a D**a",
"D**a C**l",
"N**cu P**u",
"N**se T**er",
"S***an C***tin",
"O***u A**ei",
"D**a I***l",
"P**ci V***e",
"D***mir R**a")
set.vertex.attribute(netsym, "role", c("C",
"C",
"C",
"CR",
"C",
"C",
"CT",
"CT",
"CT",
"C",
"C",
"A",
"A",
"C",
"C",
"C",
"C",
"C",
"CT",
"D",
"D"))
# C : Comerciant, CR : Cartita, CT: contrabandist, A: aducator clienti, D: depozitare
set.vertex.attribute(netsym, "abrev_name", c("BL",
"BA",
"BC",
"BG",
"MM",
"MI",
"TF",
"TG",
"SA",
"GG",
"CI",
"ML",
"DD",
"DC",
"NP",
"NT",
"SC",
"OA",
"DI",
"PV",
"DR"))
netsym %v% "alldeg" <- degree(netsym)
summary(netsym)
## Network attributes:
## vertices = 21
## directed = TRUE
## hyper = FALSE
## loops = FALSE
## multiple = FALSE
## bipartite = FALSE
## total edges = 72
## missing edges = 0
## non-missing edges = 72
## density = 0.1714286
##
## Vertex attributes:
##
## abrev_name:
## character valued attribute
## attribute summary:
## the 10 most common values are:
## BA BC BG BL CI DC DD DI DR GG
## 1 1 1 1 1 1 1 1 1 1
##
## alldeg:
## numeric valued attribute
## attribute summary:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.000 4.000 6.000 6.857 10.000 14.000
##
## role:
## character valued attribute
## attribute summary:
## A C CR CT D
## 2 12 1 4 2
## vertex.names:
## character valued attribute
## 21 valid vertex names
##
## No edge attributes
##
## Network edgelist matrix:
## [,1] [,2]
## [1,] 2 1
## [2,] 3 1
## [3,] 4 1
## [4,] 8 1
## [5,] 9 1
## [6,] 14 1
## [7,] 1 2
## [8,] 3 2
## [9,] 1 3
## [10,] 2 3
## [11,] 8 3
## [12,] 9 3
## [13,] 1 4
## [14,] 6 5
## [15,] 7 5
## [16,] 8 5
## [17,] 9 5
## [18,] 10 5
## [19,] 5 6
## [20,] 7 6
## [21,] 8 6
## [22,] 9 6
## [23,] 10 6
## [24,] 5 7
## [25,] 6 7
## [26,] 8 7
## [27,] 1 8
## [28,] 3 8
## [29,] 5 8
## [30,] 6 8
## [31,] 7 8
## [32,] 20 8
## [33,] 21 8
## [34,] 1 9
## [35,] 3 9
## [36,] 5 9
## [37,] 6 9
## [38,] 20 9
## [39,] 21 9
## [40,] 5 10
## [41,] 6 10
## [42,] 12 11
## [43,] 13 11
## [44,] 11 12
## [45,] 15 12
## [46,] 16 12
## [47,] 17 12
## [48,] 18 12
## [49,] 11 13
## [50,] 14 13
## [51,] 19 13
## [52,] 1 14
## [53,] 13 14
## [54,] 19 14
## [55,] 12 15
## [56,] 19 15
## [57,] 12 16
## [58,] 19 16
## [59,] 12 17
## [60,] 19 17
## [61,] 12 18
## [62,] 19 18
## [63,] 13 19
## [64,] 14 19
## [65,] 15 19
## [66,] 16 19
## [67,] 17 19
## [68,] 18 19
## [69,] 8 20
## [70,] 9 20
## [71,] 8 21
## [72,] 9 21
namelab <- get.vertex.attribute(netsym, "vertex.names")
rolelab <- get.vertex.attribute(netsym, "role")
abrevnamelab <-get.vertex.attribute(netsym, "abrev_name")
my_pal <- brewer.pal(5,"Dark2")
rolecat <- as.factor(get.vertex.attribute(netsym,"role"))
plot(netsym,
main = "Infractional network",
usearrows=FALSE,
mode="fruchtermanreingold",
vertex.col = my_pal[rolecat],
label=rolelab,
displaylabels=T,
vertex.cex = 1.5)
3. Different represantions
## [1] "Sociomatrix:"
print(as.sociomatrix(netsym))
## B***cu L***na B***cu An***us B**scu C***nel B**hiu G***ge
## B***cu L***na 0 1 1 1
## B***cu An***us 1 0 1 0
## B**scu C***nel 1 1 0 0
## B**hiu G***ge 1 0 0 0
## M**tu M**na 0 0 0 0
## Ma**u I***he 0 0 0 0
## T**a F**p 0 0 0 0
## T**a G***ghe 1 0 1 0
## S**m An**la 1 0 1 0
## G**ca G****ghe 0 0 0 0
## C**u I**n 0 0 0 0
## M***u L**do 0 0 0 0
## D**a D**a 0 0 0 0
## D**a C**l 1 0 0 0
## N**cu P**u 0 0 0 0
## N**se T**er 0 0 0 0
## S***an C***tin 0 0 0 0
## O***u A**ei 0 0 0 0
## D**a I***l 0 0 0 0
## P**ci V***e 0 0 0 0
## D***mir R**a 0 0 0 0
## M**tu M**na Ma**u I***he T**a F**p T**a G***ghe S**m An**la
## B***cu L***na 0 0 0 1 1
## B***cu An***us 0 0 0 0 0
## B**scu C***nel 0 0 0 1 1
## B**hiu G***ge 0 0 0 0 0
## M**tu M**na 0 1 1 1 1
## Ma**u I***he 1 0 1 1 1
## T**a F**p 1 1 0 1 0
## T**a G***ghe 1 1 1 0 0
## S**m An**la 1 1 0 0 0
## G**ca G****ghe 1 1 0 0 0
## C**u I**n 0 0 0 0 0
## M***u L**do 0 0 0 0 0
## D**a D**a 0 0 0 0 0
## D**a C**l 0 0 0 0 0
## N**cu P**u 0 0 0 0 0
## N**se T**er 0 0 0 0 0
## S***an C***tin 0 0 0 0 0
## O***u A**ei 0 0 0 0 0
## D**a I***l 0 0 0 0 0
## P**ci V***e 0 0 0 1 1
## D***mir R**a 0 0 0 1 1
## G**ca G****ghe C**u I**n M***u L**do D**a D**a D**a C**l
## B***cu L***na 0 0 0 0 1
## B***cu An***us 0 0 0 0 0
## B**scu C***nel 0 0 0 0 0
## B**hiu G***ge 0 0 0 0 0
## M**tu M**na 1 0 0 0 0
## Ma**u I***he 1 0 0 0 0
## T**a F**p 0 0 0 0 0
## T**a G***ghe 0 0 0 0 0
## S**m An**la 0 0 0 0 0
## G**ca G****ghe 0 0 0 0 0
## C**u I**n 0 0 1 1 0
## M***u L**do 0 1 0 0 0
## D**a D**a 0 1 0 0 1
## D**a C**l 0 0 0 1 0
## N**cu P**u 0 0 1 0 0
## N**se T**er 0 0 1 0 0
## S***an C***tin 0 0 1 0 0
## O***u A**ei 0 0 1 0 0
## D**a I***l 0 0 0 1 1
## P**ci V***e 0 0 0 0 0
## D***mir R**a 0 0 0 0 0
## N**cu P**u N**se T**er S***an C***tin O***u A**ei D**a I***l
## B***cu L***na 0 0 0 0 0
## B***cu An***us 0 0 0 0 0
## B**scu C***nel 0 0 0 0 0
## B**hiu G***ge 0 0 0 0 0
## M**tu M**na 0 0 0 0 0
## Ma**u I***he 0 0 0 0 0
## T**a F**p 0 0 0 0 0
## T**a G***ghe 0 0 0 0 0
## S**m An**la 0 0 0 0 0
## G**ca G****ghe 0 0 0 0 0
## C**u I**n 0 0 0 0 0
## M***u L**do 1 1 1 1 0
## D**a D**a 0 0 0 0 1
## D**a C**l 0 0 0 0 1
## N**cu P**u 0 0 0 0 1
## N**se T**er 0 0 0 0 1
## S***an C***tin 0 0 0 0 1
## O***u A**ei 0 0 0 0 1
## D**a I***l 1 1 1 1 0
## P**ci V***e 0 0 0 0 0
## D***mir R**a 0 0 0 0 0
## P**ci V***e D***mir R**a
## B***cu L***na 0 0
## B***cu An***us 0 0
## B**scu C***nel 0 0
## B**hiu G***ge 0 0
## M**tu M**na 0 0
## Ma**u I***he 0 0
## T**a F**p 0 0
## T**a G***ghe 1 1
## S**m An**la 1 1
## G**ca G****ghe 0 0
## C**u I**n 0 0
## M***u L**do 0 0
## D**a D**a 0 0
## D**a C**l 0 0
## N**cu P**u 0 0
## N**se T**er 0 0
## S***an C***tin 0 0
## O***u A**ei 0 0
## D**a I***l 0 0
## P**ci V***e 0 0
## D***mir R**a 0 0
## [1] "Edge list:"
print(as.matrix(netsym, matrix.type="edgelist"))
## [,1] [,2]
## [1,] 2 1
## [2,] 3 1
## [3,] 4 1
## [4,] 8 1
## [5,] 9 1
## [6,] 14 1
## [7,] 1 2
## [8,] 3 2
## [9,] 1 3
## [10,] 2 3
## [11,] 8 3
## [12,] 9 3
## [13,] 1 4
## [14,] 6 5
## [15,] 7 5
## [16,] 8 5
## [17,] 9 5
## [18,] 10 5
## [19,] 5 6
## [20,] 7 6
## [21,] 8 6
## [22,] 9 6
## [23,] 10 6
## [24,] 5 7
## [25,] 6 7
## [26,] 8 7
## [27,] 1 8
## [28,] 3 8
## [29,] 5 8
## [30,] 6 8
## [31,] 7 8
## [32,] 20 8
## [33,] 21 8
## [34,] 1 9
## [35,] 3 9
## [36,] 5 9
## [37,] 6 9
## [38,] 20 9
## [39,] 21 9
## [40,] 5 10
## [41,] 6 10
## [42,] 12 11
## [43,] 13 11
## [44,] 11 12
## [45,] 15 12
## [46,] 16 12
## [47,] 17 12
## [48,] 18 12
## [49,] 11 13
## [50,] 14 13
## [51,] 19 13
## [52,] 1 14
## [53,] 13 14
## [54,] 19 14
## [55,] 12 15
## [56,] 19 15
## [57,] 12 16
## [58,] 19 16
## [59,] 12 17
## [60,] 19 17
## [61,] 12 18
## [62,] 19 18
## [63,] 13 19
## [64,] 14 19
## [65,] 15 19
## [66,] 16 19
## [67,] 17 19
## [68,] 18 19
## [69,] 8 20
## [70,] 9 20
## [71,] 8 21
## [72,] 9 21
## attr(,"n")
## [1] 21
## attr(,"vnames")
## [1] "B***cu L***na" "B***cu An***us" "B**scu C***nel" "B**hiu G***ge"
## [5] "M**tu M**na" "Ma**u I***he" "T**a F**p" "T**a G***ghe"
## [9] "S**m An**la" "G**ca G****ghe" "C**u I**n" "M***u L**do"
## [13] "D**a D**a" "D**a C**l" "N**cu P**u" "N**se T**er"
## [17] "S***an C***tin" "O***u A**ei" "D**a I***l" "P**ci V***e"
## [21] "D***mir R**a"
print("Filtering networks")
## [1] "Filtering networks"
print(get.vertex.attribute(netsym, "role"))
## [1] "C" "C" "C" "CR" "C" "C" "CT" "CT" "CT" "C" "C" "A" "A" "C" "C"
## [16] "C" "C" "C" "CT" "D" "D"
comercianti <- get.inducedSubgraph(netsym, which (netsym %v% "role"=="C"))
gplot(comercianti,displaylabels=TRUE, main="Comercianti")
delete.vertices(comercianti, isolates(comercianti))
gplot(comercianti, displaylabels = TRUE, main="Grupuri de comercianti")
7. Actor proeminence
detach("package:networkD3", unload=TRUE)
detach("package:igraph", unload=TRUE)
print("CENTRALITY DEGREES")
## [1] "CENTRALITY DEGREES"
print(degree(netsym, gmode="graph"))
## [1] 6 2 4 1 5 5 3 7 6 2 2 5 3 3 2 2 2 2 6 2 2
print(closeness(netsym, gmode="graph"))
## [1] 0.4761905 0.3333333 0.3846154 0.3278689 0.3278689 0.3278689 0.3174603
## [8] 0.4166667 0.4081633 0.2531646 0.2941176 0.2564103 0.3636364 0.4444444
## [15] 0.2941176 0.2941176 0.2941176 0.2941176 0.3846154 0.3076923 0.3076923
print(betweenness(netsym, gmode="graph"))
## [1] 113.1666667 0.0000000 4.1666667 0.0000000 9.6666667 9.6666667
## [7] 0.0000000 51.0000000 36.0000000 0.0000000 3.6000000 7.0000000
## [13] 16.6000000 96.0000000 2.8500000 2.8500000 2.8500000 2.8500000
## [19] 69.4000000 0.1666667 0.1666667
#Cutpoints
cpnet <- cutpoints(netsym,mode="graph",
return.indicator=TRUE)
gplot(netsym,gmode="graph",vertex.col=cpnet+2,coord=MCoords,
jitter=FALSE,displaylabels=TRUE)
#Bridges
bridges <- function(dat,mode="graph",
connected=c("strong", "weak")) {
e_cnt <- network.edgecount(dat)
if (mode == "graph") {
cmp_cnt <- components(dat)
b_vec <- rep(FALSE,e_cnt)
for(i in 1:e_cnt){
dat2 <- dat
delete.edges(dat2,i)
b_vec[i] <- (components(dat2) != cmp_cnt)
}
}
else {
cmp_cnt <- components(dat,connected=connected)
b_vec <- rep(FALSE,e_cnt)
for(i in 1:e_cnt){
dat2 <- dat
delete.edges(dat2,i)
b_vec[i] <- (components(dat2) != cmp_cnt)
}
}
return(b_vec)
}
bridges(netsym)
## [1] FALSE FALSE TRUE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE
## [13] TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [49] FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [61] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
colors <- c("blue", "red")
# Determining the centre nodes using the degree
deg <- degree(netsym, gmode="graph")
plot(netsym,
usearrows=FALSE,
vertex.col = colors[(deg >= 5) + 1],
label = netsym %v% "abrev_name",
displaylabels=T,
vertex.cex = deg/2)
# Determining the centre nodes using the closeness function
cls <- closeness(netsym, gmode="graph")
plot(netsym,
usearrows=FALSE,
vertex.col = colors[(cls >= 0.33) + 1],
label = netsym %v% "abrev_name",
displaylabels=T,
vertex.cex = cls*10)
# Determining the centre nodes using the betweenness function
bet <- betweenness(netsym, gmode="graph")
plot(netsym,
usearrows=FALSE,
vertex.col = colors[(bet >= 90) + 1],
label = netsym %v% "abrev_name",
displaylabels=T,
vertex.cex = sqrt(bet+1))
# Computing the level of correlation between multiple centrality measures
df.prom <- data.frame(
deg = degree(netsym),
cls = closeness(netsym),
btw = betweenness(netsym),
evc = evcent(netsym),
inf = infocent(netsym),
flb = flowbet(netsym)
)
cor(df.prom)
## deg cls btw evc inf flb
## deg 1.0000000 0.6013689 0.5917256 0.6360877 0.7918289 0.5708101
## cls 0.6013689 1.0000000 0.8545112 0.4791390 0.8593100 0.8230555
## btw 0.5917256 0.8545112 1.0000000 0.2297788 0.7352932 0.9357088
## evc 0.6360877 0.4791390 0.2297788 1.0000000 0.7469055 0.3381616
## inf 0.7918289 0.8593100 0.7352932 0.7469055 1.0000000 0.7994418
## flb 0.5708101 0.8230555 0.9357088 0.3381616 0.7994418 1.0000000
# Tabular visualization for multiple centrality measures
# Defining a data frame in which is computed the centrality for all nodes using
# multiple methods
df.prom2 <- data.frame(
name = network.vertex.names(netsym),
degree = degree(netsym, gmode="graph"),
closeness = closeness(netsym, gmode="graph"),
betweenness = betweenness(netsym, gmode="graph"))
df.promsort <- df.prom2[order(-df.prom2$degree),]
cd <- centralization(netsym,degree)
cc <- centralization(netsym,closeness)
cb <- centralization(netsym,betweenness)
df.promsort <- rbind(df.promsort,data.frame(
name = "Centralization level",
degree = cd,
closeness = cc,
betweenness = cb
))
df.promsort
## name degree closeness betweenness
## 8 T**a G***ghe 7.0000000 0.4166667 51.0000000
## 1 B***cu L***na 6.0000000 0.4761905 113.1666667
## 9 S**m An**la 6.0000000 0.4081633 36.0000000
## 19 D**a I***l 6.0000000 0.3846154 69.4000000
## 5 M**tu M**na 5.0000000 0.3278689 9.6666667
## 6 Ma**u I***he 5.0000000 0.3278689 9.6666667
## 12 M***u L**do 5.0000000 0.2564103 7.0000000
## 3 B**scu C***nel 4.0000000 0.3846154 4.1666667
## 7 T**a F**p 3.0000000 0.3174603 0.0000000
## 13 D**a D**a 3.0000000 0.3636364 16.6000000
## 14 D**a C**l 3.0000000 0.4444444 96.0000000
## 2 B***cu An***us 2.0000000 0.3333333 0.0000000
## 10 G**ca G****ghe 2.0000000 0.2531646 0.0000000
## 11 C**u I**n 2.0000000 0.2941176 3.6000000
## 15 N**cu P**u 2.0000000 0.2941176 2.8500000
## 16 N**se T**er 2.0000000 0.2941176 2.8500000
## 17 S***an C***tin 2.0000000 0.2941176 2.8500000
## 18 O***u A**ei 2.0000000 0.2941176 2.8500000
## 20 P**ci V***e 2.0000000 0.3076923 0.1666667
## 21 D***mir R**a 2.0000000 0.3076923 0.1666667
## 4 B**hiu G***ge 1.0000000 0.3278689 0.0000000
## 110 Centralization level 0.1973684 0.1518153 0.5127632
# Cutpoints are nodes that if removed will affect the conectivity of the network
# In the graphic below, it is displayed with green the cutpoint nodes.
cpnet <- cutpoints(netsym,mode="graph",return.indicator=TRUE)
gplot(netsym,gmode="graph",vertex.cex=cpnet+2,vertex.col=cpnet+2,jitter=FALSE,
displaylabels=TRUE,label=netsym %v% "abrev_name")
# Bridges are edges that if removed will affect the conectivity of the network
# In the graphic below it is displayed with green the edges that are bridges.
bridges <- function(dat,mode="graph",connected=c("strong", "weak")) {
e_cnt <- network.edgecount(dat)
if (mode == "graph") {
cmp_cnt <- components(dat)
b_vec <- rep(FALSE,e_cnt)
for(i in 1:e_cnt){
dat2 <- dat
delete.edges(dat2,i)
b_vec[i] <- (components(dat2) != cmp_cnt)
}
}
else {
cmp_cnt <- components(dat,connected=connected)
b_vec <- rep(FALSE,e_cnt)
for(i in 1:e_cnt){
dat2 <- dat
delete.edges(dat2,i)
b_vec[i] <- (components(dat2,connected=connected) != cmp_cnt)
}
}
return (b_vec)
}
bridges(netsym)
## [1] FALSE FALSE TRUE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE
## [13] TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [49] FALSE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [61] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
brnet <- bridges(netsym)
gplot(netsym,gmode="graph",vertex.col="red",edge.col=brnet+2,jitter=FALSE,
displaylabels=TRUE,label=netsym %v% "abrev_name",edge.lwd=3*brnet+2)
Chapter 8
## Setup
### Import igraph for this part of the project
library(igraph)
##
## Attaching package: 'igraph'
## The following objects are masked from 'package:sna':
##
## betweenness, bonpow, closeness, components, degree, dyad.census,
## evcent, hierarchy, is.connected, neighborhood, triad.census
## The following objects are masked from 'package:network':
##
## %c%, %s%, add.edges, add.vertices, delete.edges, delete.vertices,
## get.edge.attribute, get.edges, get.vertex.attribute, is.bipartite,
## is.directed, list.edge.attributes, list.vertex.attributes,
## set.edge.attribute, set.vertex.attribute
## The following objects are masked from 'package:stats':
##
## decompose, spectrum
## The following object is masked from 'package:base':
##
## union
library(intergraph)
### Transfer network from statnet format to igraph format
inetsym <- as.undirected(asIgraph(netsym))
V(inetsym)$name <- netsym %v% "abrev_name"
V(inetsym)$fullname <- network.vertex.names(netsym)
V(inetsym)$role <- rolecat
## Cliques
### Determine the cliques from the network as well as the biggest clique.
clique.number(inetsym)
## [1] 4
## [[1]]
## + 3/21 vertices, named, from ef17298:
## [1] MI TF TG
##
## [[2]]
## + 3/21 vertices, named, from ef17298:
## [1] DD DC DI
##
## [[3]]
## + 3/21 vertices, named, from ef17298:
## [1] BL BA BC
##
## [[4]]
## + 3/21 vertices, named, from ef17298:
## [1] BL BC SA
##
## [[5]]
## + 3/21 vertices, named, from ef17298:
## [1] BL BC TG
##
## [[6]]
## + 3/21 vertices, named, from ef17298:
## [1] MM MI TF
##
## [[7]]
## + 4/21 vertices, named, from ef17298:
## [1] MM MI TF TG
##
## [[8]]
## + 3/21 vertices, named, from ef17298:
## [1] MM MI GG
##
## [[9]]
## + 3/21 vertices, named, from ef17298:
## [1] MM MI SA
##
## [[10]]
## + 3/21 vertices, named, from ef17298:
## [1] MM MI TG
##
## [[11]]
## + 3/21 vertices, named, from ef17298:
## [1] MM TF TG
maximal.cliques(inetsym, min=3)
## [[1]]
## + 3/21 vertices, named, from ef17298:
## [1] BA BL BC
##
## [[2]]
## + 3/21 vertices, named, from ef17298:
## [1] DC DD DI
##
## [[3]]
## + 3/21 vertices, named, from ef17298:
## [1] GG MM MI
##
## [[4]]
## + 4/21 vertices, named, from ef17298:
## [1] TF MM TG MI
##
## [[5]]
## + 3/21 vertices, named, from ef17298:
## [1] MM MI SA
##
## [[6]]
## + 3/21 vertices, named, from ef17298:
## [1] BC BL TG
##
## [[7]]
## + 3/21 vertices, named, from ef17298:
## [1] BC BL SA
## [[1]]
## + 4/21 vertices, named, from ef17298:
## [1] TG MM MI TF
## k-Cores
coreness <- graph.coreness(inetsym)
table(coreness)
## coreness
## 1 2 3
## 1 13 7
maxCoreness <- max(coreness)
maxCoreness
## [1] 3
colors <- rainbow(maxCoreness)
plot(inetsym,vertex.label=coreness,vertex.color=colors[coreness],layout=layout_with_fr)
i1_3 <- inetsym
i2_3 <- induced.subgraph(inetsym, vids=which(coreness > 1))
i3_3 <- induced.subgraph(inetsym, vids=which(coreness > 2))
lay <- layout.fruchterman.reingold(inetsym)
op <- par(mfrow=c(1,3),mar = c(3,0,2,0))
plot(i1_3,layout=lay,vertex.label=coreness,vertex.color=colors[coreness],main="All k-cores")
plot(i2_3,layout=lay[which(coreness > 1),],vertex.label=coreness[which(coreness > 1)],vertex.color=colors[coreness[which(coreness > 1)]],main="k-cores 2-3")
plot(i3_3,layout=lay[which(coreness > 2),],vertex.label=coreness[which(coreness > 2)],vertex.color=colors[coreness[which(coreness > 2)]],main="k-cores 3")
par(op)
## Modularity is a measure that describes how good is a network clusterization
colors <- brewer.pal(5,"Dark2")
roles <- c("C","CR","CT","A","D")
V(inetsym)[V(inetsym)$role == "C"]$color <- colors[1]
V(inetsym)[V(inetsym)$role == "CR"]$color <- colors[2]
V(inetsym)[V(inetsym)$role == "CT"]$color <- colors[3]
V(inetsym)[V(inetsym)$role == "A"]$color <- colors[4]
V(inetsym)[V(inetsym)$role == "D"]$color <- colors[5]
V(inetsym)[V(inetsym)$role == "C"]$group <- 1
V(inetsym)[V(inetsym)$role == "CR"]$group <- 2
V(inetsym)[V(inetsym)$role == "CT"]$group <- 3
V(inetsym)[V(inetsym)$role == "A"]$group <- 4
V(inetsym)[V(inetsym)$role == "D"]$group <- 5
op <- par(mfrow=c(1,1))
plot(inetsym,vertex.color=V(inetsym)$color,vertex.size=10)
## Modularity based on the role of each person
modularity(inetsym, V(inetsym)$group)
## [1] 0
## The result is smaller than 0, which means a bad clusterization result using this method
## Community detection algorithms
cw <- cluster_walktrap(inetsym)
modularity(cw)
## [1] 0.4903549
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 3 3 3 3 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 2 2
ceb <- cluster_edge_betweenness(inetsym)
modularity(ceb)
## [1] 0.4903549
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 1 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 2 2
cs <- cluster_spinglass(inetsym)
modularity(cs)
## [1] 0.4903549
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 1 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 2 2
cfg <- cluster_fast_greedy(inetsym)
modularity(cfg)
## [1] 0.4695216
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 1 1 1 1 3 3 3 3 1 3 2 2 2 2 2 2 2 2 2 1 1
clp <- cluster_label_prop(inetsym)
modularity(clp)
## [1] 0.4756944
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 1 1 1 1 2 2 2 1 1 2 3 3 3 3 3 3 3 3 3 1 1
cle <- cluster_leading_eigen(inetsym)
modularity(cle)
## [1] 0.464892
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 1 1 1 1 3 3 3 3 1 3 2 2 2 2 2 2 2 2 2 3 3
cl <- cluster_louvain(inetsym)
modularity(cl)
## [1] 0.4903549
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR
## 3 3 3 3 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 1 1
table(V(inetsym)$role,membership(cw))
##
## 1 2 3
## 1 2 0 0
## 2 6 3 3
## 3 0 0 1
## 4 1 3 0
## 5 0 2 0
compare(as.numeric(factor(V(inetsym)$role)),cw,method="adjusted.rand")
## [1] 0.02816901
compare(cw,ceb,method="adjusted.rand")
## [1] 1
compare(cw,cs,method="adjusted.rand")
## [1] 1
compare(cw,cfg,method="adjusted.rand")
## [1] 0.7075812
op <- par(mfrow=c(3,2),mar=c(3,0,2,0))
plot(ceb, inetsym,vertex.label=V(inetsym)$name,main="Edge Betweenness")
plot(cfg, inetsym,vertex.label=V(inetsym)$name,main="Fastgreedy")
plot(clp, inetsym,vertex.label=V(inetsym)$name,main="Label Propagation")
plot(cle, inetsym,vertex.label=V(inetsym)$name,main="Leading Eigenvector")
plot(cs, inetsym,vertex.label=V(inetsym)$name,main="Spinglass")
plot(cw, inetsym,vertex.label=V(inetsym)$name,main="Walktrap")
